home *** CD-ROM | disk | FTP | other *** search
/ System Booster / System Booster.iso / Archives / ARexxTools / PedigreeGuide.lha / PedigreeGuide.rexx < prev   
Encoding:
OS/2 REXX Batch file  |  1995-10-18  |  25.0 KB  |  734 lines
  1. /*****************************************************************************
  2.  PedigreeGuide.rexx by Ron Goertz, 223 Clay Ct, Pullman, WA  99163
  3.  
  4.  $VER: PedigreeGuide 1.01 (18 Oct 1995)
  5.  
  6.  An ARexx script to make an AmigaGuide hypertext in the format of a pedigree
  7.    chart based on the current IRN of an open ScionGenealogist data base.
  8.  
  9.  Derived from "Scion2Guide.rexx" by Robbie Akins.
  10.  *****************************************************************************/
  11. options results
  12. signal on IOERR
  13. arg outval
  14.  
  15. do while outval = '?'
  16.   writeln(stdout, "NOGUI/S - turns off GUI")
  17.   pull outval
  18. end
  19.  
  20. /* Check if Scion is running */
  21. if ~show('P','SCIONGEN') then do
  22.    say 'Please start the SCION program BEFORE using this script!'
  23.    EXIT
  24. end
  25. Address "SCIONGEN"      /* Point at Scion Genealogist port */
  26.  
  27. /* Initialize variables */
  28. DefaultViewer = 'Display'         /* Default viewer if pre- v4.09     */
  29. TempFile = 'ram:ScionTempFile'    /* Used for Name List               */
  30. PrevGen = 0                       /* Used in building pedigree        */
  31. PedigreeLine = 2                  /* Used for links back to pedigree  */
  32. MaxLen.1 = 22                     /* Length of buttons in Name List   */
  33. MaxLen.3 = 30                     /* Length of all other name buttons */
  34. EndReason.0 = 'an unknown reason' /* Reasons for marriages ending     */
  35. EndReason.1 = 'an unknown reason'
  36. EndReason.2 = 'divorce'
  37. EndReason.3 = 'separation'
  38. EndReason.4 = 'annulment'
  39. EndReason.5 = 'death'
  40.  
  41. 'GETPROGVERSION'; Version = result
  42. 'GETDBName';      DBName = result
  43. 'GETCURRENTIRN';  CurrentIRN = result
  44. 'GETDBPATH';      DBPath = result
  45.  
  46. /* add libraries */
  47. if exists('libs:rexxreqtools.library') then do
  48.    call addlib('rexxreqtools.library',0,-30,0)
  49.    usereq = 1
  50. end
  51. else usereq = 0
  52.  
  53. if exists('libs:rexxarplib.library') then do
  54.    call addlib('rexxarplib.library',0,-30,0)
  55.    showprogress = 1
  56. end
  57. else showprogress = 0
  58.  
  59. if outval == "NOGUI" | outval == 'NOREQ' then do
  60.    usereq = 0
  61.    showprogress = 0
  62. end
  63.  
  64. /*** Start program itself ***/
  65. if Version > 4.08 then do
  66.    'GETVIEWER'; Viewer = result
  67. end
  68. if Viewer == '' then Viewer = DefaultViewer
  69.  
  70. if Version < 4.07 then do
  71.    if usereq == 1 then
  72.       rtezrequest('Requires Scion Version 4.07 (or greater)','Cancel','PedigreeGuide Message:')
  73.    else say 'Requires Scion Version 4.07 (or greater)'
  74.    exit
  75. end
  76.  
  77. EXISTPERSON CurrentIRN
  78. if result ~= 'YES' then exit
  79.  
  80. lastchar = right(DBPath,1)
  81. if lastchar ~= ":" then DBPath = DBPath'/'  /* If path does not end with a ":", append a "/" */
  82.  
  83. /*** Get output location ***/
  84. if usereq == 1 then do
  85.    outfile = rtfilerequest('RAM:','Pedigree.guide','Select Path and Name for Guide:',,'rtfi_buffer=true', choice)
  86.    if choice == 0 | outfile == '' then EXIT
  87. end
  88. else do
  89.    writech(stdout, 'Enter Path and Name for Guide: ')
  90.    parse pull outfile
  91.    if outfile == '' then EXIT
  92. end
  93. lastcolon = LastPos(':', outfile)
  94. lastslash = lastpos('/', outfile)
  95. filename = substr(outfile,max(lastcolon, lastslash) + 1)
  96.  
  97. /*** Open file for writing and initialize with guide information ***/
  98. if ~Open('PedigreeFile',outfile,'w') then do
  99.    if usereq == 1 then do
  100.       call rtezrequest('Unable to open 'outfile' for writing;'|| '0A'x ||,
  101.                        'check for other processes using this file.')
  102.       exit
  103.    end
  104.    else do
  105.       say 'Unable to open 'outfile' for writing; check for other processes using this file.'
  106.       exit
  107.    end
  108. end
  109.  
  110. WriteLn('PedigreeFile','@database "'filename'"')
  111. WriteLn('PedigreeFile','@Index NameList')
  112. WriteLn('PedigreeFile','@author "Ronald Goertz"')
  113. WriteLn('PedigreeFile','@(c) "Copyright © 1995 Ronald Goertz"')
  114. WriteLn('PedigreeFile','@$VER: PedigreeGuide V1.01 (18 Oct 95)')
  115. WriteLn('PedigreeFile','@width 77')
  116.  
  117. /*** Count generations in database ***/
  118. ReportProgress('Counting generations ...')
  119.  
  120. MaxGen = 0
  121. CountGen(CurrentIRN,'P',0)
  122. CountGen(CurrentIRN,'M',0)
  123. if showprogress == 1 then Postmsg()
  124.  
  125. /*** From user, get number of generations to process ***/
  126. if usereq == 1 then do
  127.    RequestedGen = rtgetlong(MaxGen,'How many of the' || '0A'x ||,
  128.                                     MaxGen' generations' || '0A'x ||,
  129.                                    'should be included?','PedigreeGuide',,,choice)
  130.    if choice == 0 | RequestedGen == 0 | RequestedGen == '' then exit
  131. end
  132. else do
  133.    writech(stdout, 'How many of the 'MaxGen' generations should be included? ')
  134.    pull RequestedGen
  135.    if RequestedGen == 0 | RequestedGen == '' then exit
  136. end
  137. if RequestedGen < MaxGen then MaxGen = RequestedGen
  138.  
  139. /***  Make pedigree node of guide ***/
  140. do i = 1 to MaxGen
  141.    Gen.i = '    '
  142. end
  143.  
  144. ReportProgress('Building Pedigree ...')
  145.  
  146. WriteLn('PedigreeFile', '@NODE Main "Pedigree"')
  147. WriteLn('PedigreeFile','')
  148. WriteLn('PedigreeFile','@{" Names " LINK NameList}')
  149. WriteLn('PedigreeFile','')
  150.  
  151. AddAncestor(CurrentIRN,'P',0)
  152.  
  153. 'GETLASTNAME' CurrentIRN;  LASTNAME = result
  154. 'GETFIRSTNAME' CurrentIRN; FIRSTNAME = result
  155. 'GETBIRTHDATE' CurrentIRN; BIRTHDATE = right(result,11)
  156. 'GETDEATHDATE' CurrentIRN; DEATHDATE = right(result,11)
  157. FULLNAME = TransformName(LASTNAME, FIRSTNAME)
  158. WriteLn('PedigreeFile',' |')
  159. WriteCh('PedigreeFile','@{" 'left(FULLNAME, MaxLen.3)' " LINK P'CurrentIRN'}')
  160. IF BIRTHDATE ~= "" THEN WriteCh('PedigreeFile',' b:'BIRTHDATE)
  161. IF DEATHDATE ~= "" THEN WriteCh('PedigreeFile',' d:'DEATHDATE)
  162. WriteLn('PedigreeFile','')
  163. PedigreeLine = PedigreeLine + 2
  164. Node.CurrentIRN = PedigreeLine
  165.  
  166. AddAncestor(CurrentIRN,'M',0)
  167.  
  168. WriteLn('PedigreeFile','@ENDNODE')
  169. WriteLn('PedigreeFile','')
  170.  
  171. /***  Add individual nodes to guide ***/
  172. if showprogress == 0 then say 'Processing records ...'
  173. Open('NameList', TempFile, 'w')
  174. call AddNodes(CurrentIRN, 'P', 0)
  175. call AddNodes(CurrentIRN, 'M', 0)
  176. Close('NameList')
  177.  
  178. /*** Create name list node ***/
  179.  
  180. ReportProgress('Creating list of names ...')
  181. ADDRESS COMMAND sort TempFile TempFile
  182.  
  183. WriteLn('PedigreeFile', '@NODE NameList "Name List"')
  184. WriteLn('PedigreeFile','')
  185. WriteLn('PedigreeFile','@{"   Pedigree    " LINK Main}')
  186. WriteLn('PedigreeFile','')
  187.  
  188. LinesSoFar = 4
  189. LNameLen = 0
  190. /*** Count number of family names & number of records for each ***/
  191. Open('SortedList',TempFile,'r')
  192.    LName = '~'
  193.    Families = 0
  194.    do while ~EOF('SortedList')
  195.       line = ReadLn('SortedList')
  196.       if line == '' then leave
  197.       LastName = left(line, pos(',', line) - 1)
  198.       if LastName =='' then LastName = '0'
  199.       if LastName ~= LName then do
  200.          if length(LastName) > LNameLen then LNameLen = length(LastName)
  201.          Families = Families + 1
  202.          LName = LastName
  203.          FamilyName.Families = LName
  204.          NameCount.Families = 0
  205.       end
  206.       NameCount.Families = NameCount.Families + 1
  207.    end
  208. Close('SortedList')
  209.  
  210. if FamilyName.1 == '0' then do
  211.    FirstName = 2
  212.    LinesSoFar = LinesSoFar + NameCount.1 + 2
  213. end
  214. else FirstName = 1
  215.  
  216. /*** Calculate links per row and number of link rows ***/
  217. LinksPerRow = trunc(75 / (LNameLen + 3))
  218. row = trunc((Families - FirstName) / LinksPerRow, 0)
  219. if (Families - FirstName) // LinksPerRow ~= 0 then row = row + 1
  220.  
  221. /*** Add familyname links ***/
  222. LinesSoFar = LinesSoFar + row
  223. row = 0
  224. column = 0
  225. do i = FirstName to Families
  226.    WriteCh('PedigreeFile', '@{" 'center(FamilyName.i, LNameLen)' " LINK NameList 'LinesSoFar'} ')
  227.    LinesSoFar = LinesSoFar + NameCount.i + 2
  228.    NL = 0
  229.    column = column + 1
  230.    if column == LinksPerRow then do
  231.       WriteLn('PedigreeFile', '')
  232.       row = row + 1
  233.       column = 0
  234.       NL = 1
  235.    end
  236. end
  237. if NL == 0 then do
  238.    WriteLn('PedigreeFile', '')
  239.    row = row + 1
  240. end
  241.  
  242. /*** Add record links ***/
  243. Open('SortedList',TempFile,'r')
  244.    LName = ''
  245.    Entries = 0
  246.    do while ~EOF('SortedList')
  247.       line = ReadLn('SortedList')
  248.       if line == '' then leave
  249.       LastName = left(line, pos(',', line) - 1)
  250.       if LastName == '' then LastName = 'Last Name Unknown'
  251.       FirstName = substr(line, pos(',', line) + 1)
  252.       FirstName = strip(left(FirstName, pos('|',FirstName) - 1))
  253.       Birthday = substr(line, pos('|', line) + 1)
  254.       Birthday = strip(left(Birthday, pos('>',Birthday) - 1))
  255.       IRN = substr(line, pos('>',line) + 1)
  256.       if LastName ~= LName then do
  257.          LName = LastName
  258.          WriteLn('PedigreeFile','')
  259.          WriteLn('PedigreeFile', LastName)
  260.       end
  261.       WriteLn('PedigreeFile', '   @{" 'left(FirstName, MaxLen.1)' " LINK P'IRN'} 'Birthday)
  262.       Entries = Entries + 1
  263.    end
  264. Close('SortedList')
  265. WriteLn('PedigreeFile','')
  266. WriteLn('PedigreeFile','('Entries' people added to 'filename')')
  267. WriteLn('PedigreeFile','')
  268. WriteLn('PedigreeFile','@ENDNODE')
  269. Close('PedigreeFile')
  270. ADDRESS COMMAND 'delete >NIL: 'TempFile
  271. if showprogress == 1 then PostMsg()
  272.  
  273. if usereq == 1 then call rtezrequest(filename 'complete.')
  274. else say filename' complete.'
  275.  
  276. exit
  277. end
  278.  
  279. /*************************************/
  280. /*  Find individuals to add to guide */
  281. /*************************************/
  282. AddNodes:PROCEDURE EXPOSE MaxGen MaxLen. DBPath DBName Viewer Node. showprogress PedigreeLine EndReason.
  283.    PARSE ARG irn, familyside, generation
  284.  
  285.    generation = generation + 1
  286.    'GETPARENTS' irn
  287.    if familyside == 'P' then 'GETPRINCIPAL' result
  288.    else 'GETSPOUSE' result
  289.    pirn = result
  290.  
  291.    if pirn ~= '' then do
  292.       if generation < MaxGen then AddNodes(pirn,'P',generation)
  293.       AddInfo(pirn, generation)
  294.       if generation < MaxGen then AddNodes(pirn,'M',generation)
  295.    end
  296.    return 0
  297.  
  298. /*********************************/
  299. /*  Add inividual nodes to guide */
  300. /*********************************/
  301. AddInfo: PROCEDURE EXPOSE MaxGen DBPath DBName Viewer showprogress PedigreeLine MaxLen. Node. EndReason.
  302.    PARSE ARG irn, generation
  303.  
  304.    if Node.irn == 1 | Node.irn < 0 then return 0
  305.  
  306.    'GETLASTNAME' irn;    LASTNAME = result
  307.    'GETFIRSTNAME' irn;   FIRSTNAME = result
  308.    'GETPARENTS' irn;     PARENTS = result
  309.    'GETNUMMARRY' irn;    MARRIAGES = result
  310.    'GETTOTALCHILD' irn;  TOTALCHILDREN = result
  311.    'GETBIRTHDATE' irn;   BIRTHDATE = result
  312.    'GETBIRTHPLACE' irn;  BIRTHPLACE = result
  313.    'GETDEATHDATE' irn;   DEATHDATE = result
  314.    'GETDEATHPLACE' irn;  DEATHPLACE = result
  315.    'GETBURIALDATE' irn;  BURIALDATE = result
  316.    'GETBURIALPLACE' irn; BURIALPLACE = result
  317.    'GETOCCUPATION' irn;  OCCUPATION = result
  318.    'GETEDUCATION' irn;   EDUCATION = result
  319.    'GETRELIGION' irn;    RELIGION = result
  320.    'GETDIEDOF' irn;      DIEDOF = result
  321.    'GETPERSCOMMENT' irn; COMMENT = result
  322.    'GETPERSREFS' irn;    REFS = result
  323.    FULLNAME = TransformName(LASTNAME, FIRSTNAME)
  324.    FootNote = 0
  325.  
  326.    if showprogress == 1 then Postmsg(10, 10, "\\Processing "||FULLNAME, "SCIONGEN")
  327.    if datatype(right(BIRTHDATE,4)) == 'NUM' then Birthday = '( 'right(BIRTHDATE,4)' - '
  328.    else Birthday = '( - '
  329.    if datatype(right(DEATHDATE,4)) == 'NUM' then Birthday = Birthday''right(DEATHDATE,4)' )'
  330.    else Birthday = Birthday')'
  331.    WriteLn('NameList', LASTNAME', 'FIRSTNAME'|'Birthday'>'irn)
  332.    WriteLn('PedigreeFile', '@NODE P'irn' "'FULLNAME'"')
  333.  
  334. /*** Add links ***/
  335.    WriteLn('PedigreeFile','')
  336.    WriteCh('PedigreeFile',' @{" Pedigree " LINK Main')
  337.    if datatype(Node.irn) == 'NUM' then WriteCh('PedigreeFile',' 'Node.irn)
  338.    WriteLn('PedigreeFile','} @{" Names " LINK NameList}')
  339.    if datatype(Node.irn) == 'NUM' then Node.irn = -Node.irn
  340.    else Node.irn = 1
  341.  
  342.    LinkLine = ''
  343.    if Exists(DBPath'PN'irn'.'DBName) then do
  344.       LinkLine = ' @{" Personal Note " LINK P'irn'Note}'
  345.       AddPNote = 1
  346.    end
  347.    else AddPNote = 0
  348.    if Exists(DBPath'PP'irn'.'DBName) then
  349.       LinkLine = LinkLine' @{" Individual Picture " RXS "address command '"'" Viewer' 'DBPath'PP'irn'.'DBName"'"'"}'
  350.    if LinkLine ~= '' then WriteCh('PedigreeFile',LinkLine)
  351.  
  352.    LinkLine = ''
  353.    if Exists(DBPath'FN'PARENTS'.'DBName) then do
  354.       LinkLine = ' @{" Family Note " LINK F'PARENTS'Note}'
  355.       AddFNote = 1
  356.    end
  357.    else AddFNote = 0
  358.    if Exists(DBPath'FP'PARENTS'.'DBName) then
  359.       LinkLine = LinkLine' @{" Family Picture " RXS "address command '"'" Viewer' 'DBPath'FP'PARENTS'.'DBName"'"'"}'
  360.    if LinkLine ~= '' then WriteLn('PedigreeFile',LinkLine)
  361.  
  362. /*** Add personal information ***/
  363.    WriteLn('PedigreeFile','')
  364.    WriteLn('PedigreeFile', '@{b}'trim(center(FULLNAME, 75))'@{ub}')
  365.    WriteLn('PedigreeFile','')
  366.  
  367.    if BIRTHDATE || BIRTHPLACE ~= "" then do
  368.       WriteCh('PedigreeFile','Born ')
  369.       if BIRTHDATE ~= "" then WriteCh('PedigreeFile','on 'BIRTHDATE)
  370.       if BIRTHPLACE ~= "" then WriteCh('PedigreeFile',' in 'BIRTHPLACE)
  371.       WriteLn('PedigreeFile','')
  372.    end
  373.  
  374.    if DEATHDATE || DEATHPLACE ~= "" then do
  375.       WriteCh('PedigreeFile','Died ')
  376.       if DEATHDATE ~= "" then WriteCh('PedigreeFile','on 'DEATHDATE)
  377.       if DEATHPLACE ~= "" then WriteCh('PedigreeFile',' in 'DEATHPLACE)
  378.       WriteLn('PedigreeFile','')
  379.    end
  380.  
  381.    if BURIALDATE || BURIALPLACE ~= "" then do
  382.       WriteCh('PedigreeFile','Buried ')
  383.       if BURIALDATE ~= "" then WriteCh('PedigreeFile','on 'BURIALDATE)
  384.       if BURIALPLACE ~= "" then WriteCh('PedigreeFile',' in 'BURIALPLACE)
  385.       WriteLn('PedigreeFile','')
  386.    end
  387.  
  388.    WriteLn('PedigreeFile','')
  389.    if DIEDOF ~= "" then WriteLn('PedigreeFile',    "   Died of: "DIEDOF)
  390.    if OCCUPATION ~= "" then WriteLn('PedigreeFile',"Occupation: "OCCUPATION)
  391.    if EDUCATION ~= "" then WriteLn('PedigreeFile', " Education: "EDUCATION)
  392.    if RELIGION ~= "" then WriteLn('PedigreeFile',  "  Religion: "RELIGION)
  393.    if COMMENT ~= "" then WriteLn('PedigreeFile',   "  Comments: "COMMENT)
  394.    if REFS ~= "" then WriteLn('PedigreeFile',      "References: "REFS)
  395.  
  396. /*** Add parents ***/
  397.    WriteLn('PedigreeFile',COPIES("=", 75))
  398.    WriteLn('PedigreeFile','')
  399.    if MARRIAGES = 1 then SHeading = 'Spouse'
  400.    else if MARRIAGES > 1 then SHeading = 'Spouses'
  401.    else SHeading = ''
  402.    if TOTALCHILDREN = 1 then CHeading = 'Child'
  403.    else if TOTALCHILDREN > 1 then CHeading = 'Children'
  404.    else CHeading = ''
  405.  
  406.    if SHeading == '' & CHeading == '' then Heading = ''
  407.    else if SHeading == '' | CHeading == '' then Heading = 'and 'SHeading''CHeading
  408.    else Heading = ', 'SHeading', and 'CHeading
  409.  
  410.    WriteLn('PedigreeFile','Parents'Heading' of 'FULLNAME)
  411.    WriteLn('PedigreeFile','')
  412.    if PARENTS ~> 0 then do
  413.       WriteLn('PedigreeFile','Unknown -- Unknown')
  414.       PCHILDREN = 0
  415.    end
  416.    else do
  417.       prefix = '  |'
  418.       'GETPRINCIPAL' PARENTS;   IRN.1 = result
  419.       'GETSPOUSE' PARENTS;      IRN.2 = result
  420.       'GETNUMCHILD' PARENTS;    PCHILDREN = result
  421.  
  422.       'GETSEX' IRN.1
  423.       if result == 'F' then do
  424.          temp = IRN.1
  425.          IRN.1 = IRN.2
  426.          IRN.2 = temp
  427.       end
  428.  
  429.       do i = 1 to 2
  430.          if IRN.i == '' then INFO = 'Unknown'
  431.          else do
  432.             'GETLASTNAME' IRN.i;  PLASTNAME.i = result
  433.             'GETFIRSTNAME' IRN.i; PFIRSTNAME = result
  434.             PFULLNAME = TransformName(PLASTNAME.i, PFIRSTNAME)
  435.             if generation < MaxGen then INFO = '@{" 'center(PFULLNAME,MaxLen.3)' " LINK P'IRN.i'}'
  436.             else INFO = PFULLNAME
  437.          end
  438.          if i == 1 then WriteCh('PedigreeFile',INFO' -- ')
  439.          else WriteLn('PedigreeFile',INFO)
  440.       end
  441.  
  442.       WriteLn('PedigreeFile',Prefix)
  443.  
  444. /*** Add siblings ***/
  445.       do i = 0 to PCHILDREN - 1
  446.          'GETCHILD' PARENTS i; CHILD = result
  447.          'GETLASTNAME' CHILD;  CLASTNAME = result
  448.          'GETFIRSTNAME' CHILD; CFIRSTNAME = result
  449.          'GETBIRTHDATE' CHILD; CBIRTHDATE = result
  450.          'GETDEATHDATE' CHILD; CDEATHDATE = result
  451.          CNAME = TransformName(CLASTNAME, CFIRSTNAME)
  452.  
  453.          PedMark = ' '
  454.          if datatype(Node.CHILD) = 'NUM' then
  455.             if abs(Node.CHILD) > 1 then do
  456.                PedMark = '>'
  457.                FootNote = 1
  458.             end
  459.  
  460.          if i == PCHILDREN - 1 then Prefix = overlay('+',Prefix,3)
  461.          if CHILD == irn & MARRIAGES > 0 THEN WriteCh('PedigreeFile',overlay('+-',Prefix)'--- @{b}'PedMark' 'left(CNAME,MaxLen.3)'@{ub} ')
  462.          else if CHILD == irn & MARRIAGES == 0 THEN WriteCh('PedigreeFile',Prefix'--- @{b}'PedMark' 'left(CNAME,MaxLen.3)'@{ub} ')
  463.          else WriteCh('PedigreeFile',Prefix'--- @{"'PedMark' 'left(CNAME,MaxLen.3)' " LINK P'CHILD'}')
  464.          if CBIRTHDATE ~= "" then WriteCh('PedigreeFile',' b:'CBIRTHDATE)
  465.          if CDEATHDATE ~= "" then WriteCh('PedigreeFile',' d:'CDEATHDATE)
  466.          WriteLn('PedigreeFile','')
  467.          if CHILD == irn & MARRIAGES > 0 then Prefix = overlay('|',Prefix)
  468.       end
  469.    end
  470.  
  471. /*** Add marriages ***/
  472.    if MARRIAGES > 0 then do
  473.       Prefix = '|'
  474.       do i = 0 to MARRIAGES - 1
  475.          if i == MARRIAGES - 1 then Prefix = ' '
  476.          WriteLn('PedigreeFile','|')
  477.          WriteLn('PedigreeFile','|')
  478.          'GETMARRIAGE' irn i; FGRN = result
  479.          'GETNUMCHILD' FGRN;  CHILDREN = result
  480.          'GETSPOUSE' FGRN;    SPOUSE = result
  481.          if SPOUSE = irn then do
  482.             'GETPRINCIPAL' FGRN; SPOUSE = result
  483.          end
  484.          'GETLASTNAME' SPOUSE;  SLASTNAME = result
  485.          'GETFIRSTNAME' SPOUSE; SFIRSTNAME = result
  486.          'GETBIRTHDATE' SPOUSE; SBIRTHDATE = result
  487.          'GETDEATHDATE' SPOUSE; SDEATHDATE = result
  488.          'GETENGAGEDATE' FGRN;  ENGAGEDATE = result
  489.          'GETENGAGEPLACE' FGRN; ENGAGEPLACE = result
  490.          'GETMARRYDATE' FGRN;   MARRYDATE = result
  491.          'GETMARRYPLACE' FGRN;  MARRYPLACE = result
  492.          'GETENDDATE' FGRN;     ENDDATE = result
  493.          'GETENDPLACE' FGRN;    ENDPLACE = result
  494.          'GETENDING' FGRN;      REASON = result
  495.          'GETCELEBRANT' FGRN;   CELEBRANT = result
  496.          'GETWITNESS' FGRN;     WITNESS = result
  497.          'GETFAMCOMMENT' FGRN;  FAMCOMMENT = result
  498.          'GETFAMREFS' FGRN;     FAMREFS = result
  499.          if SPOUSE > 0 then SFULLNAME = TransformName(SLASTNAME, SFIRSTNAME)
  500.          else SFULLNAME = 'Unknown'
  501.          if CHILDREN > 0 then CPrefix = '|'
  502.          else CPrefix = ' '
  503.  
  504.          if generation > 0 & SPOUSE > 0 then
  505.             WriteCh('PedigreeFile','+----- @{" 'left(SFULLNAME,MaxLen.3)' " LINK P'SPOUSE'}')
  506.          else
  507.             WriteCh('PedigreeFile','+-----  'left(SFULLNAME,MaxLen.3)' ')
  508.          if SBIRTHDATE ~= "" then WriteCh('PedigreeFile',' b:'SBIRTHDATE)
  509.          if SDEATHDATE ~= "" then WriteCh('PedigreeFile',' d:'SDEATHDATE)
  510.          WriteLn('PedigreeFile','')
  511.  
  512.          if ENGAGEDATE ~= "" | ENGAGEPLACE ~= "" then do
  513.             WriteCh('PedigreeFile',Prefix'        'CPrefix'    Engaged ')
  514.             if ENGAGEDATE ~= "" then WriteCh('PedigreeFile','on 'ENGAGEDATE' ')
  515.             if ENGAGEPLACE ~= "" then WriteCh('PedigreeFile','in 'ENGAGEPLACE)
  516.             WriteLn('PedigreeFile','')
  517.          end
  518.  
  519.          if MARRYDATE ~= "" | MARRYPLACE ~= "" then do
  520.             WriteCh('PedigreeFile',Prefix'        'CPrefix'    Married ')
  521.             if MARRYDATE ~= "" then WriteCh('PedigreeFile','on 'MARRYDATE' ')
  522.             if MARRYPLACE ~= "" then WriteCh('PedigreeFile','in 'MARRYPLACE)
  523.             WriteLn('PedigreeFile','')
  524.          end
  525.  
  526.          if CELEBRANT ~= '' then WriteLn('PedigreeFile',Prefix'        'CPrefix'    Married by 'CELEBRANT)
  527.          if WITNESS ~= '' then WriteLn('PedigreeFile',Prefix'        'CPrefix'    Witnessed by 'WITNESS)
  528.  
  529.          if ENDDATE ~= "" | ENDPLACE ~= "" then do
  530.             WriteCh('PedigreeFile',Prefix'        'CPrefix'    Ended ')
  531.             if ENDDATE ~= "" then WriteCh('PedigreeFile','on 'ENDDATE' ')
  532.             if ENDPLACE ~= "" then WriteCh('PedigreeFile','in 'ENDPLACE' ')
  533.             WriteLn('PedigreeFile','due to 'EndReason.REASON)
  534.          end
  535.  
  536.          if FAMREFS ~= '' then WriteLn('PedigreeFile',Prefix'        'CPrefix'    References: 'FAMREFS)
  537.          if FAMCOMMENT ~= '' then WriteLn('PedigreeFile',Prefix'        'CPrefix'       Comment: 'FAMCOMMENT)
  538.  
  539. /*** Add children ***/
  540.          if CHILDREN > 0 then do
  541.             WriteLn('PedigreeFile',Prefix'        'CPrefix)
  542.             do j = 0 to CHILDREN - 1
  543.                'GETCHILD' FGRN j;    CHILD = result
  544.                'GETLASTNAME' CHILD;  CLASTNAME = result
  545.                'GETFIRSTNAME' CHILD; CFIRSTNAME = result
  546.                'GETBIRTHDATE' CHILD; CBIRTHDATE = result
  547.                'GETDEATHDATE' CHILD; CDEATHDATE = result
  548.                CNAME = TransformName(CLASTNAME, CFIRSTNAME)
  549.  
  550.                PedMark = ' '
  551.                if datatype(Node.CHILD) = 'NUM' then
  552.                   if abs(Node.CHILD) > 1 then do
  553.                      PedMark = '>'
  554.                      FootNote = 1
  555.                   end
  556.  
  557.                if j == CHILDREN - 1 then CPrefix = '+'
  558.                if generation >0 then
  559.                   WriteCh('PedigreeFile',Prefix'        'CPrefix'--- @{"'PedMark' 'left(CNAME,MaxLen.3)'" LINK P'CHILD'}')
  560.                else
  561.                   WriteCh('PedigreeFile',Prefix'        'CPrefix'---  'left(CNAME,MaxLen.3))
  562.                if CBIRTHDATE ~= "" then WriteCh('PedigreeFile',' b:'CBIRTHDATE)
  563.                if CDEATHDATE ~= "" then WriteCh('PedigreeFile',' d:'CDEATHDATE)
  564.                WriteLn('PedigreeFile','')
  565.             end
  566.          end
  567.       end
  568.    end
  569.    if FootNote == 1 then do
  570.       WriteLn('PedigreeFile','')
  571.       WriteLn('PedigreeFile','')
  572.       WriteLn('PedigreeFile','( > indicates child listed in pedigree )')
  573.    end
  574.  
  575.    WriteLn('PedigreeFile', '@ENDNODE')
  576.    WriteLn('PedigreeFile','')
  577.  
  578. /*** Add note nodes if necessary ***/
  579.    if AddPNote then do
  580.       Open('INDLNOTE',DBPath'PN'irn'.'DBName,'r')
  581.       WriteLn('PedigreeFile','@NODE P'irn'Note')
  582.       do while ~EOF('INDLNOTE')
  583.          line = ReadLn('INDLNOTE')
  584.          WriteLn('PedigreeFile',line)
  585.       end
  586.       WriteLn('PedigreeFile','@ENDNODE')
  587.       WriteLn('PedigreeFile','')
  588.       Close('INDLNOTE')
  589.    end
  590.  
  591.    if AddFNote then do
  592.       Open('FAMNOTE',DBPath'FN'PARENTS'.'DBName,'r')
  593.       WriteLn('PedigreeFile','@NODE F'PARENTS'Note')
  594.       do while ~EOF('FAMNOTE')
  595.          line = ReadLn('FAMNOTE')
  596.          WriteLn('PedigreeFile',line)
  597.       end
  598.       WriteLn('PedigreeFile','@ENDNODE')
  599.       WriteLn('PedigreeFile','')
  600.       Close('FAMNOTE')
  601.    end
  602.  
  603. /*** Add sibling nodes if necessary ***/
  604.    if PCHILDREN > 1 then do
  605.       do i = 0 to PCHILDREN - 1
  606.          'GETCHILD' PARENTS i; CHILD = result
  607.          AddInfo(CHILD, generation)
  608.       end
  609.    end
  610.  
  611. /*** Add spouse and child nodes if necessary ***/
  612.    if MARRIAGES > 0 & generation > 0 then do
  613.       do i = 0 to MARRIAGES - 1
  614.          'GETMARRIAGE' irn i; FGRN = result
  615.          'GETNUMCHILD' FGRN;  CHILDREN = result
  616.          'GETSPOUSE' FGRN;    SPOUSE = result
  617.          if SPOUSE = irn then do
  618.             'GETPRINCIPAL' FGRN; SPOUSE = result
  619.          end
  620.          if SPOUSE > 0 then AddInfo(SPOUSE, generation)
  621.          if CHILDREN > 0 then do
  622.             do j = 0 to CHILDREN - 1
  623.                'GETCHILD' FGRN j; CHILD = result
  624.                AddInfo(CHILD, generation - 1)
  625.             end
  626.          end
  627.       end
  628.    end
  629.  
  630.    RETURN 0
  631.  
  632. /**********************/
  633. /*  Count generations */
  634. /**********************/
  635. CountGen:PROCEDURE EXPOSE MaxGen
  636.    PARSE ARG irn, familyside, generation
  637.  
  638.    generation = generation + 1
  639.    'GETPARENTS' irn
  640.    if familyside == 'P' then 'GETPRINCIPAL' result
  641.    else 'GETSPOUSE' result
  642.    pirn = result
  643.  
  644.    if pirn ~= '' then do
  645.       CountGen(pirn,'P',generation)
  646.       if generation > MaxGen then MaxGen = generation
  647.       CountGen(pirn,'M',generation)
  648.    end
  649.    return 0
  650.  
  651. /*******************************/
  652. /* Add people to pedigree node */
  653. /*******************************/
  654. AddAncestor: PROCEDURE EXPOSE MaxGen PrevGen PedigreeLine MaxLen. Gen. Node.
  655.    PARSE ARG irn, familyside, generation
  656.  
  657.    generation = generation + 1
  658.    'GETPARENTS' irn;       PARENTS = result
  659.    'GETPRINCIPAL' PARENTS; PRINCIPAL = result
  660.    'GETSPOUSE' PARENTS;    SPOUSE = result
  661.    'GETSEX' PRINCIPAL
  662.    if familyside == 'P' then do
  663.       if result == 'M' then pirn = PRINCIPAL
  664.       else pirn = SPOUSE
  665.    end
  666.    else do
  667.       if result == 'F' then pirn = PRINCIPAL
  668.       else pirn = SPOUSE
  669.    end
  670.  
  671.    if pirn ~= '' then do
  672.       if generation < MaxGen then AddAncestor(pirn,'P',generation)
  673.       'GETLASTNAME'  pirn; LASTNAME = result
  674.       'GETFIRSTNAME' pirn; FIRSTNAME = result
  675.       'GETBIRTHDATE' pirn; BIRTHDATE = right(result,11)
  676.       'GETDEATHDATE' pirn; DEATHDATE = right(result,11)
  677.       FULLNAME = TransformName(LASTNAME, FIRSTNAME)
  678.  
  679.       if PrevGen < generation then DoTo = generation
  680.       else DoTo = PrevGen
  681.  
  682.       prefix = ''
  683.       do i = 1 to DoTo
  684.          prefix = prefix Gen.i
  685.       end
  686.       WriteLn('PedigreeFile',prefix)
  687.  
  688.       prefix = ''
  689.       do i = 1 to generation - 1
  690.          prefix = prefix Gen.i
  691.       end
  692.  
  693.       WriteCh('PedigreeFile',prefix' +---@{" 'left(FULLNAME,MaxLen.3)' " LINK P'pirn'}')
  694.       IF BIRTHDATE ~= "" THEN WriteCh('PedigreeFile',' b:'BIRTHDATE)
  695.       IF DEATHDATE ~= "" THEN WriteCh('PedigreeFile',' d:'DEATHDATE)
  696.       WriteLn('PedigreeFile','')
  697.       PedigreeLine = PedigreeLine + 2
  698.       Node.pirn = PedigreeLine
  699.  
  700.       if familyside = 'P' then Gen.generation = '|   '
  701.       else Gen.Generation = '    '
  702.       PrevGen = generation
  703.       if generation < MaxGen then AddAncestor(pirn,'M',generation)
  704.    end
  705.    else if familyside == 'P' then Gen.generation = '|   '
  706.    else if familyside == 'M' then Gen.Generation = '    '
  707.  
  708.    return 0
  709.  
  710. /*******************************************************************************************************/
  711.  
  712. TransformName: PROCEDURE
  713.    parse arg LName, FName
  714.  
  715.    CommaLoc = pos(',', FName)
  716.    if CommaLoc == 0 then Name = FName' 'LName
  717.    else Name = left(FName, CommaLoc - 1)' 'LName''substr(FName, CommaLoc)
  718.  
  719.    return Name
  720.  
  721. ReportProgress:
  722.    parse arg str
  723.    if usereq == 1 then
  724.       Postmsg(10, 10, "PedigreeGuide by Ron Goertz               \Database: "||DBName||"\"||str, "SCIONGEN")
  725.    else say str
  726.    return 0
  727.  
  728. IOERR:
  729.   bline = SIGL
  730.   say "I/O error #"||RC||" detected in line "||bline||":"
  731.   say sourceline(bline)
  732.   if showprogress then Postmsg()
  733.   EXIT
  734.